/* GUI CONVERTED from rsautorc.p (converter v1.76) Sun Aug 25 21:00:04 2002 */
/* rsautorc.p - AUTOMATIC RECEIPT OF PO SHIPPER FROM IMPORT OF ASN           */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                       */
/* All rights reserved worldwide.  This is an unpublished work.              */
/* $Revision: 1.11 $                                                              */
/*V8:ConvertMode=Maintenance                                                 */

/* Revision: 1.4         BY: Jean Miller       DATE: 08/08/01  ECO: *M11Z*  */
/* Revision: 1.6         BY: Jeff Wootton      DATE: 05/23/02  ECO: *P075*  */
/* Revision: 1.7         BY: Paul Dreslinski   DATE: 05/30/02  ECO: *P07J*  */
/* Revision: 1.9         BY: Steve Nugent      DATE: 06/13/02  ECO: *P08K*  */
/* $Revision: 1.11 $          BY: Vivek Gogte       DATE: 08/06/02  ECO: *N1QQ*  */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

{mfdeclre.i}
{gplabel.i}

{gldydef.i new}
{gldynrm.i new}

define input  parameter supplier_id        like vd_addr     no-undo.
define input  parameter shipper_id         like abs_id      no-undo.
define output parameter successful_receipt like mfc_logical no-undo.

define new shared variable rndmthd       like rnd_rnd_mthd.
define new shared variable qty_left      like tr_qty_chg.
define new shared variable trqty         like tr_qty_chg.
define new shared variable qty_req       like in_qty_req.
define new shared variable loc           like pt_loc.
define new shared variable lot_ser       like pt_lot_ser.
define new shared variable i             as   integer.
define new shared variable qty           as   decimal.
define new shared variable part          as   character format "x(18)".
define new shared variable sod_recno     as   recid.
define new shared variable fas_so_rec    as   character.
define new shared variable ship_db       like global_db.
define new shared variable change_db     like mfc_logical.
define new shared variable ship_so       like so_nbr.
define new shared variable ship_line     like sod_line.
define new shared variable qty_ord       like sod_qty_ord.
define new shared variable qty_inv       like sod_qty_inv.
define new shared variable qty_chg       like sod_qty_chg.
define new shared variable trgl_recno    as   recid.
define new shared variable sct_recno     as   recid.
define new shared variable accum_wip     like tr_gl_amt.
define new shared variable nbr           like tr_nbr.
define new shared variable cr_acct       like trgl_cr_acct.
define new shared variable cr_cc         like trgl_cr_cc.
define new shared variable cr_proj       like trgl_cr_proj.
define new shared variable qty_iss_rcv   like tr_qty_loc.
define new shared variable sct_recid     as   recid.
define new shared variable tr_recno      as   recid.
define new shared variable issrct        as   character format "x(3)".
define new shared variable conv          like um_conv no-undo.
define new shared variable unit_cost     like tr_price.
define new shared variable ordernbr      like tr_nbr.
define new shared variable orderline     like tr_line.
define new shared variable so_job        like tr_so_job.
define new shared variable addr          like tr_addr.
define new shared variable rmks          like tr_rmks.
define new shared variable dr_acct       like trgl_dr_acct.
define new shared variable dr_cc         like trgl_dr_cc.
define new shared variable project       like wo_project.
define new shared variable lotserial_qty like sr_qty no-undo.
define new shared variable gl_sum        like mfc_logical initial yes.
define new shared variable undo_all      like mfc_logical initial no.
define new shared variable batch         like ar_batch.
define new shared variable inv           like ar_nbr.
define new shared variable name          like ad_name.
define new shared variable desc1         like pt_desc1 format "x(49)".
define new shared variable yn            like mfc_logical.
define new shared variable post          like mfc_logical.
define new shared variable curr_amt      like glt_amt.
define new shared variable cust          like so_cust.
define new shared variable receivernbr   like prh_receiver.
define new shared variable maint         like mfc_logical no-undo
                                         initial true.
define new shared variable undo_trl2     like mfc_logical no-undo.
define new shared variable vendlot       like tr_vend_lot no-undo.
define new shared variable fiscal_rec    as   logical initial false.
define new shared variable fiscal_id     like prh_receiver.
define new shared variable ship_dt       like so_ship_date.
define new shared variable um            like pt_um no-undo.
define new shared variable confirm_mode  like mfc_logical no-undo.
define new shared variable l_recalc      like mfc_logical no-undo
                                         initial yes.
define new shared variable qopen         like pod_qty_rcvd.
define new shared variable receipt_date  like prh_rcp_date no-undo.
define new shared variable prm-avail     like mfc_logical
                                         initial no no-undo.
/* KANBAN TRANSACTION NUMBER NEEDED FOR POPORCB8.P */
define new shared variable kbtransnbr    as integer no-undo.

define new shared variable l_undo       like mfc_logical no-undo.
define new shared variable l_ld_part    like pt_part     no-undo.

define     shared variable global_recid  as   recid.

{porcdef.i "new" "new"}

define buffer pod2 for pod_det.
define buffer pod3 for pod_det.

define variable oldcurr           like po_curr       no-undo.
define variable ship_date         like prh_ship_date no-undo.
define variable undo_loop1        like mfc_logical   no-undo.
define variable disp_abs_id       like abs_id        no-undo.
define variable abs_recid         as   recid         no-undo.
define variable so_auto_count     as   integer       no-undo.
define variable so_not_auto_count as   integer       no-undo.
define variable newprice          as   decimal       no-undo.
define variable qty_to_rcv        as   decimal       no-undo.
define variable work_qty          like sr_qty        no-undo.
define variable any_subcontract   as   logical       no-undo.
define variable total_received    like pod_qty_rcvd  no-undo.
define variable dummy_disc        like pod_disc_pct  no-undo.
define variable pc_recno          as   recid         no-undo.

define variable shipnbr           like tr_ship_id      no-undo.
define variable inv_mov           like tr_ship_inv_mov no-undo.

define variable undo_tran         like mfc_logical no-undo.
define variable doc-type          as   character   no-undo.
define variable doc-ref           as   character   no-undo.
define variable add-ref           as   character   no-undo.
define variable msg-type          as   character   no-undo.
define variable trq-id            like trq_id      no-undo.
define variable l_list_price      as   decimal     no-undo.
define variable l_flag            like mfc_logical no-undo.
define variable undo-loop         as   logical     no-undo.
define variable mc-error-number   like msg_nbr     no-undo.
define variable auto_receipt      like mfc_logical no-undo.
define variable price_qty         as   decimal     no-undo.
define variable l_tot_qty         like pod_qty_rcvd no-undo.
define variable op_rctpo_trnbr    like tr_trnbr    no-undo.

define new shared workfile tax_wkfl
   field tax_nbr        like pod_nbr
   field tax_line       like pod_line
   field tax_env        like pod_tax_env
   field tax_usage      like pod_tax_usage
   field tax_taxc       like pod_taxc
   field tax_in         like pod_tax_in
   field tax_taxable    like pod_taxable
   field tax_price      like prh_pur_cost.

{gpglefdf.i}

/* WORKFILE FOR POD RECEIPT ATTRIBUTES */
define new shared workfile attr_wkfl no-undo
  field chg_line     like sr_lineid
  field chg_assay    like tr_assay
  field chg_grade    like tr_grade
  field chg_expire   like tr_expire
  field chg_status   like tr_status
  field assay_actv   as   logical
  field grade_actv   as   logical
  field expire_actv  as   logical
  field status_actv  as   logical.

{rcwabsdf.i new}

{gprun.i ""socrshc.p""}
/*GUI*/ if global-beam-me-up then undo, leave.


for first poc_ctrl
fields (poc_rcv_nbr poc_rcv_pre poc_tol_cst poc_tol_pct)
no-lock: end. /* FOR FIRST POC_CTRL */

for first shc_ctrl
fields (shc_ship_rcpt)
no-lock: end. /* FOR FIRST SHC_CTRL */

assign
   auto_receipt = yes
   successful_receipt = no.

for first abs_mstr
fields (abs_cum_qty abs_id abs_line abs_loc abs_lotser abs_order
        abs_qty abs_ref abs_shipfrom abs_shipto abs_ship_qty
        abs_shp_date abs_site abs_status abs_type abs__qad06)
where abs_shipfrom = supplier_id
  and abs_id       = "s" + shipper_id
  and abs_type     = "r"
no-lock: end. /* FOR FIRST ABS_MSTR */

eff_date = today.

/*SET THE FLAG SO POPORCB.P WILL NOT CHG THE STATUS OF POD_DET IF*/
/* THE LINE IS NOT RECEIVED */

shipper_rec = true.

mainloop:
do on error undo, leave:
/*GUI*/ if global-beam-me-up then undo, leave.


   run del_sr_wkfl.

   /* SET THE FISCAL ID FOR TAX ROUTINES */
   assign
      fiscal_id = string(abs_shipfrom, "x(8)") + substring(abs_id,2,50)
      abs_recid = recid(abs_mstr)
      ps_nbr    = substring(abs_id,2,50)
      eff_date  = today
      ship_date = if abs_mstr.abs_shp_date <> ? then
                   abs_mstr.abs_shp_date else eff_date
      ship_dt   = if abs_mstr.abs_shp_date <> ? then
                   abs_mstr.abs_shp_date else eff_date.

   run assign-shipdb
      (input abs_shipto).

   if ship_db <> global_db then do:
      /* You must be in database */
      {pxmsg.i &MSGNUM=8191 &ERRORLEVEL=3}
      bell.
      undo, leave.
   end.

   /* MAKE SURE SHIP-FROM DATABASE IS CONNECTED */
   if global_db <> "" and not connected(ship_db) then do:
      /* DATABASE # NOT AVAILABLE */
      {pxmsg.i &MSGNUM=2510 &ERRORLEVEL=3 &MSGARG1=ship_db}
      undo, leave.
   end.

   for each work_abs_mstr exclusive-lock:
      delete work_abs_mstr.
   end.

   /* EXPLODE SHIPPER TO GET ORDER DETAIL */
   {gprun.i ""rcsoisa.p"" "(input recid(abs_mstr))"}
/*GUI*/ if global-beam-me-up then undo, leave.


   /* THE PROCEDURE P_GLCALVAL, VERIFIES OPEN GL PERIOD FOR */
   /* SITE/ENTITY OF EACH LINE ITEM                         */
   run p_glcalval
      (output l_flag).
   if l_flag then do:
      undo mainloop, leave mainloop.
   end. /* IF L_FLAG */


   /* GO THRU WORKFILE FOR VALIDATION OF ORDERS AND SET CURRENT PURCH PRICE */
   assign
      so_not_auto_count = 0
      so_auto_count = 0
      any_subcontract = no.

   for each work_abs_mstr no-lock,
       each pod_det exclusive-lock
       where pod_part = work_abs_mstr.abs_item
       and   pod_nbr  = abs_order
       and   pod_line = integer(abs_line),
          each po_mstr
          fields (po_curr po_ex_rate po_ex_rate2 po_fix_rate
                  po_nbr po_so_nbr po_vend po_so_nbr) no-lock
     where po_nbr = pod_nbr
   break by pod_nbr by pod_line
   on error undo mainloop, leave mainloop:

      for first sod_det where
                sod_nbr = po_so_nbr and
                sod_line = pod_sod_line and
                sod_btb_type = "03"
      no-lock: end.
      if not available sod_det then leave mainloop.

      if first-of(pod_nbr) then do:

         for each pod2 where
                  pod2.pod_nbr = pod_det.pod_nbr
              and pod2.pod_qty_chg <> 0
         no-lock:
            find pod3 where recid(pod3) = recid(pod2) exclusive-lock.
            assign
               pod3.pod_qty_chg = 0.
         end.

         if po_fix_rate = no then do:
            /* GET EXCHANGE RATE */
            {gprunp.i "mcpl" "p" "mc-get-ex-rate"
               "(input po_curr,
                 input base_curr,
                 input exch_ratetype,
                 input eff_date,
                 output exch_rate,
                 output exch_rate2,
                 output mc-error-number)"}
            if mc-error-number <> 0 then do:
               {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=3}
               undo mainloop, leave mainloop.
            end.
         end.
         else
            assign
               exch_rate = po_ex_rate
               exch_rate2 = po_ex_rate2.

      end. /* if first-of(pod_nbr) */

      /* TOLERANCE CHECKING */
      qty_to_rcv = abs_qty - abs_ship_qty.
      accumulate qty_to_rcv(sub-total by pod_line).

      if last-of(pod_line) then do:

         assign
            total_received = ((accum sub-total by pod_line qty_to_rcv)
                               / pod_um_conv) + pod_qty_rcvd
            base_amt = pod_pur_cost.

         if po_curr <> base_curr then do:
            {gprunp.i "mcpl" "p" "mc-curr-conv"
               "(input po_curr,
                 input base_curr,
                 input exch_rate,
                 input exch_rate2,
                 input base_amt,
                 input false, /* DO NOT ROUND */
                 output base_amt,
                 output mc-error-number)"}
         end.

         if pod_sched or (not pod_sched and
           (total_received > pod_qty_ord and pod_qty_ord > 0) or
           (total_received < pod_qty_ord and pod_qty_ord < 0))
         then do:
            {gprun.i ""rsporct.p""
               "(input (accum sub-total by pod_line qty_to_rcv),
                 input recid(po_mstr),
                 input recid(pod_det),
                 input eff_date,
                 input poc_tol_pct,
                 input poc_tol_cst,
                 input base_amt,
                 input no,
                 input yes,
                 output undo_loop1)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            if undo_loop1 then undo mainloop, leave mainloop.
         end.

         {gprun.i ""rsplqty.p""
            "(input recid(pod_det),
              input ((accum sub-total by pod_line qty_to_rcv) / pod_um_conv),
              output price_qty)"}
/*GUI*/ if global-beam-me-up then undo, leave.


         assign
            l_list_price = 0
            newprice     = 0.

         {gprun.i ""gppccal.p""
            "(input        pod_part,
              input        price_qty,
              input        pod_um,
              input        pod_um_conv,
              input        po_curr,
              input        pod_pr_list,
              input        eff_date,
              input        pod_pur_cost,
              input        no,
              input        0.0,
              input-output l_list_price,
              output       dummy_disc,
              input-output newprice,
              output       pc_recno)" }
/*GUI*/ if global-beam-me-up then undo, leave.


         /* IF NO LIST PRICE WAS FOUND LETS TRY TO CHECK FOR   */
         /* A VP_Q_PRICE FOR THE ITEM.  IF WE CANT FIND ONE,   */
         /* POD_PRICE WILL REMAIN AS IT WAS ORIGINALLY.        */
         if pc_recno = 0 or newprice = 0
         then do:

            for first vp_mstr
            fields (vp_curr vp_part vp_q_price vp_q_qty vp_um
                    vp_vend vp_vend_part)
            where vp_part = pod_part
            and   vp_vend = po_vend
            and   vp_vend_part = pod_vpart
            no-lock: end. /* FOR FIRST VP_MSTR */

            if available vp_mstr     and
               price_qty >= vp_q_qty and
               pod_um = vp_um        and
               vp_q_price > 0        and
               po_curr = vp_curr
            then
               pod_pur_cost = vp_q_price.

         end. /* IF PC_RECNO = 0 OR NEWPRICE = 0 */
         else
            pod_pur_cost = newprice.

      end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* last-of pod_line */

   end. /* for each work_abs_mstr */

   do transaction:
/*GUI*/ if global-beam-me-up then undo, leave.

      {mfnxtsq.i wo_mstr wo_lot woc_sq01 trlot}
   end.
/*GUI*/ if global-beam-me-up then undo, leave.


   /* GO THRU WORKFILE AND PERFORM CONTAINER ITEM RECEIPTS */
   for each work_abs_mstr no-lock
   where work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty,
   each abs_mstr exclusive-lock
   where abs_mstr.abs_shipfrom = work_abs_mstr.abs_shipfrom
   and abs_mstr.abs_id = work_abs_mstr.abs_id:

      run del_sr_wkfl.

      find pod_det where
           pod_nbr = abs_order and
           pod_line = integer(abs_line)
      exclusive-lock no-error.

      if not available pod_det and abs_item > "" then do:

         for first pt_mstr
         fields (pt_iss_pol pt_part pt_prod_line pt_site)
         where pt_part = abs_item
         no-lock:  end. /* FOR FIRST PT_MSTR */

         if available pt_mstr then do:

            for first in_mstr
            fields (in_cur_set in_gl_set in_part in_site in_gl_cost_site)
            where  in_site = pt_site
              and  in_part = pt_part
            no-lock: end. /* FOR FIRST IN_MSTR */

            for first pl_mstr
            fields (pl_cop_acct pl_cop_cc
                    pl_flr_acct pl_flr_cc
                    pl_prod_line pl_pur_acct pl_pur_cc)
            where pl_prod_line = pt_prod_line
            no-lock: end. /* FOR FIRST PL_MSTR */

            {gpsct03.i &cost=sct_cst_tot}

            create sr_wkfl.
            assign
               rmks        = getTermLabel("CONTAINER_RECEIPT",24)
               global_part = abs_item
               part        = abs_item
               sr_userid   = mfguser
               sr_lineid   = abs_mstr.abs_line
               sr_site     = abs_mstr.abs_site
               sr_loc      = abs_mstr.abs_loc
               sr_lotser   = abs_mstr.abs_lotser
               sr_ref      = abs_mstr.abs_ref
               sr_qty      = abs_mstr.abs_qty - abs_mstr.abs_ship_qty
               unit_cost   = glxcst
               so_job      = ""
               addr        = abs_mstr.abs_shipto
               cr_acct     = pl_pur_acct
               cr_cc       = pl_pur_cc
               project     = ""
               dr_acct     = if not pt_iss_pol then pl_flr_acct
                             else pl_cop_acct
               dr_cc       = if not pt_iss_pol then pl_flr_cc
                              else pl_cop_cc
               transtype   = "RCT-UNP"
               issrct      = "RCT"
               conv        = 1.

            if recid(sr_wkfl) = -1 then .

            {gprun.i ""icintra.p"" "(shipnbr, ship_date, '', false)" }
/*GUI*/ if global-beam-me-up then undo, leave.


            if available sr_wkfl then delete sr_wkfl.

         end. /* if available pt_mstr */

         abs_mstr.abs_ship_qty = abs_mstr.abs_qty.

      end.

   end.  /* FOR EACH */

   run dotrans1
      (output undo-loop).

   if undo-loop then
      undo mainloop, leave mainloop.

   do trans:

      /* MARK SHIPPER CONFIRMED */
      find abs_mstr where recid(abs_mstr) = abs_recid exclusive-lock.
      assign
        substring(abs_status,2,1) = "y".

      if abs_shp_date = ? then
         abs_shp_date = eff_date.

      for first so_mstr
      fields (so_nbr so_primary so_secondary)
      where so_nbr = abs_order
      no-lock:  end. /* FOR FIRST SO_MSTR */

      /* If Middle Business Unit */
      if available so_mstr
         and so_primary = yes
         and so_secondary = yes
      then do:

         for first sod_det
         fields (sod_btb_type sod_cfg_type sod_fa_nbr
                sod_line sod_nbr)
         where sod_nbr      = abs_order
         and   sod_line     = integer(abs_line)
         and   sod_btb_type = "03"
         no-lock: end. /* FOR FIRST SOD_DET */

         if available sod_det then do:

            for first ad_mstr
            fields (ad_addr ad_edi_ctrl ad_line1 ad_name)
            where ad_addr = abs_mstr.abs_shipto
            no-lock: end. /* FOR FIRST AD_MSTR */

            if available ad_mstr and
               substring(ad_edi_ctrl[1],1,1) = "e"
            then do:

               assign
                  doc-type = "ASN"
                  doc-ref  = abs_mstr.abs_shipfrom
                  add-ref  = abs_id
                  msg-type = "ASN".

               /* QUEUE DOCUMENT FOR TRANSMISSION - BTB */
               {gprun.i ""gpquedoc.p""
                  "(input-output doc-type,
                    input-output abs_shipfrom,
                    input-output abs_id,
                    input-output msg-type,
                    input-output trq-id,
                    input yes)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            end.

         end. /* if available sod_det */

      end.

   end.   /* END TRANSACTION */

   global_recid = abs_recid.

   run del_sr_wkfl.

   hide message no-pause.
   successful_receipt = yes.

end.

PROCEDURE upd-kit-inv:
/*-----------------------------------------------------------
  Purpose:      Update Kit Inventory

  Parameters:   undo_receipt  If yes the receipt will be
                              undone
  Notes:
-------------------------------------------------------------*/
define output parameter undo_receipt like mfc_logical no-undo.

   undo_receipt = no.

   for each work_abs_mstr no-lock
   where work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty,
   each abs_mstr
   fields (abs_cum_qty abs_id abs_line abs_loc abs_lotser abs_order
           abs_qty abs_ref abs_shipfrom abs_shipto abs_ship_qty
           abs_shp_date abs_site abs_status abs_type abs__qad06)
   no-lock
   where abs_mstr.abs_shipfrom = work_abs_mstr.abs_shipfrom
   and   abs_mstr.abs_id       = work_abs_mstr.abs_id,
   each po_mstr
   fields (po_curr po_ex_rate po_ex_rate2 po_fix_rate
           po_nbr po_so_nbr po_vend) no-lock
   where po_nbr = abs_mstr.abs_order,
   each pod_det
   fields (pod_bo_chg pod_curr_rlse_id pod_line pod_nbr pod_op
           pod_part pod_pr_list pod_ps_chg pod_pur_cost
           pod_qty_chg pod_qty_ord pod_qty_rcvd pod_sched
           pod_site pod_sod_line pod_type pod_um pod_um_conv
           pod_vpart pod_wo_lot) no-lock
   where pod_part = work_abs_mstr.abs_item
   and   pod_nbr  = abs_mstr.abs_order
   and   pod_line = integer(abs_mstr.abs_line)
   break by pod_nbr by pod_line:

      for first sod_det
      fields (sod_btb_type sod_cfg_type sod_fa_nbr sod_line sod_nbr)
      where sod_nbr  = po_so_nbr
      and   sod_line = pod_sod_line
      no-lock: end. /* FOR FIRST SOD_DET */

      if available sod_det and sod_btb_type <> "03"
      then
         undo_receipt = yes.

      if available sod_det
               and sod_cfg_type = "2"
               and sod_fa_nbr = ""
      then do:

         accumulate abs_mstr.abs_qty (total by pod_line).

         if last-of(pod_line)
         then do:

            confirm_mode = no.
            sod_recno = recid(sod_det).

            {gprun.i ""rcsoisk.p""
               "(input recid(abs_mstr),
                 input confirm_mode,
                 input (accumulate total by pod_line
                               abs_mstr.abs_qty))"}
/*GUI*/ if global-beam-me-up then undo, leave.

         end. /* if last-of(pod_line) */

      end. /* if available sod_det and sod_cfg_type = "2" */

    end. /* for each work_abs_mstr ... breab by pod_nbr */

END PROCEDURE.

PROCEDURE p-chk-act-schd:
/*-----------------------------------------------------------
  Purpose:      Check to see if there is an active schedule

  Parameters:   l_pod_sched
                l_curr_rlse

  Notes:
-------------------------------------------------------------*/
define input parameter l_pod_sched like pod_sched           no-undo.
define input parameter l_curr_rlse like pod_curr_rlse_id[1] no-undo.

   if l_pod_sched and
      l_curr_rlse = ""
   then do:
        /* NO ACTIVE SCHEDULE EXISTS */
        {pxmsg.i &MSGNUM=2362 &ERRORLEVEL=2}
   end. /* IF POD_SCHED */

END PROCEDURE.

PROCEDURE del_sr_wkfl:
/*-----------------------------------------------------------
  Purpose:      Clean up Workfile

  Parameters:   <None>

  Notes:
-------------------------------------------------------------*/

   for each sr_wkfl exclusive-lock where sr_userid = mfguser:
      delete sr_wkfl.
   end.

END PROCEDURE.

PROCEDURE assign-shipdb:
/*-----------------------------------------------------------
  Purpose:      Assign the Ship Database

  Parameters:   shipto   Ship-To Site

  Notes:
-------------------------------------------------------------*/
define input parameter shipto like abs_mstr.abs_shipto.

   for first si_mstr
   fields (si_db si_entity si_site)
   where si_site = shipto
   no-lock: end. /* FOR FIRST SI_MSTR */

   if not can-find(first dc_mstr)
   then do:
      ship_db = global_db.
   end.
   else do:
      ship_db = si_db.
   end.

END PROCEDURE.

PROCEDURE p_glcalval:
/*-----------------------------------------------------------
  Purpose:      GL Calendar Validation

  Parameters:   l-flag  If No, then calendar is not valid

  Notes:
-------------------------------------------------------------*/
define output parameter l_flag like mfc_logical no-undo.

   for each work_abs_mstr
   where    work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty and
           (work_abs_mstr.abs_id begins "i" or
            work_abs_mstr.abs_id begins "c")
   no-lock :

      for first si_mstr
      fields ( si_db si_entity si_site )
      where si_site = work_abs_mstr.abs_site
      no-lock: end. /* FOR FIRST SI_MSTR */

      if available si_mstr then do:
         /* CHECK GL EFFECTIVE DATE */
         {gpglef01.i ""IC"" si_entity eff_date}
         if gpglef > 0 then do:
            {pxmsg.i &MSGNUM=gpglef &ERRORLEVEL=4 &MSGARG1=si_entity}
            l_flag = yes.
            return.
         end. /* IF GPGLEF > 0 */
      end. /* IF AVAILABLE SI_MSTR */

   end. /* FOR EACH WORK_ABS_MSTR */

END PROCEDURE.

PROCEDURE check_supperf:
/*-----------------------------------------------------------
  Purpose:      Check to see if Supplier Performance Installed

  Parameters:   abs_recid

  Notes:
-------------------------------------------------------------*/
define input parameter abs_recid as recid no-undo.

   if can-find (mfc_ctrl where
                mfc_field = "enable_supplier_perf" and
                mfc_logical) and
      can-find (_File where _File-name = "vef_ctrl")
   then do:
      {gprunmo.i
         &program=""rspove.p""
         &module="ASP"
         &param="""(input abs_recid,
                    input auto_receipt)"""}
   end.  /* if enable supplier performance */

END PROCEDURE.

PROCEDURE dotrans1:
/*-----------------------------------------------------------
  Purpose:

  Parameters:   <None>

  Notes:
-------------------------------------------------------------*/
define output parameter undo-loop as logical    no-undo.

define variable undo_receipt like mfc_logical no-undo.

   undo-loop = no.

   do transaction:
/*GUI*/ if global-beam-me-up then undo, leave.


      for each work_abs_mstr no-lock
      where work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty,
      each abs_mstr
      exclusive-lock
      where abs_mstr.abs_shipfrom = work_abs_mstr.abs_shipfrom
        and abs_mstr.abs_id = work_abs_mstr.abs_id,
      each po_mstr
      fields (po_curr po_ex_rate po_ex_rate2 po_fix_rate
              po_nbr po_so_nbr po_vend po_so_nbr) no-lock
      where po_nbr = abs_mstr.abs_order,
      each pod_det exclusive-lock
      where pod_nbr = abs_mstr.abs_order and
            pod_line = integer(abs_mstr.abs_line)
        and pod_part = work_abs_mstr.abs_item
      break by pod_nbr by pod_line:

         for first sod_det where
                   sod_nbr = po_so_nbr  and
                   sod_line = pod_sod_line and
                   sod_btb_type = "03"
         no-lock: end.

         if not available sod_det then undo-loop = yes.

         if first-of(pod_nbr) then do:

            run del_sr_wkfl.

            if work_abs_mstr.abs__qad06 <> "" then do:
               /* CLEAR ALL THE TAX WORK FILE */
               for each tax_wkfl exclusive-lock where tax_nbr = po_nbr :
                  delete tax_wkfl.
               end.
            end.

         end.

         find sr_wkfl
         where sr_userid = mfguser
           and sr_lineid = abs_mstr.abs_line
           and sr_site = abs_mstr.abs_site
           and sr_loc = abs_mstr.abs_loc
           and sr_lotser = abs_mstr.abs_lotser
           and sr_ref = abs_mstr.abs_ref
         exclusive-lock no-error.

         if not available sr_wkfl then do:

            create sr_wkfl.
            assign
               sr_userid = mfguser
               sr_lineid = abs_mstr.abs_line
               sr_site = abs_mstr.abs_site
               sr_loc = abs_mstr.abs_loc
               sr_lotser = abs_mstr.abs_lotser
               sr_ref = abs_mstr.abs_ref.

            if recid(sr_wkfl) = -1 then .

         end.

         /* STORING THE QUANTITY IN INVENTORY UM TO     */
         /* AVOID ROUNDING ERRORS IN LD_DET AND TR_HIST */
         assign
            work_qty   = (abs_mstr.abs_qty - abs_mstr.abs_ship_qty)
                           / pod_um_conv
            sr_qty     = sr_qty + work_qty
            l_tot_qty  = decimal(sr__qadc01) + (abs_mstr.abs_qty
                                               - abs_mstr.abs_ship_qty)
            sr__qadc01 = string(l_tot_qty).

         accumulate work_qty(sub-total by pod_line).

         if last-of(pod_line) then do:

            pod_qty_chg = accum sub-total by pod_line work_qty.
            pod_ps_chg  = abs_mstr.abs_cum_qty.

            /* SET THE POD_BO_CHG VALUE TO STOP POPORCB.P FROM  */
            /* CHANGING THE STATUS OF THE POD_LINE , TO RECEIVE */
            /* PARTIAL QTY                                      */
            pod_bo_chg  = pod_qty_ord - (pod_qty_chg + pod_qty_rcvd ).

            if work_abs_mstr.abs__qad06 <> "" then do:

               /* THE ABS_MSTR ARE FROM FISCAL RECEIVING */
               create tax_wkfl.
               assign
                  tax_nbr     =  pod_nbr
                  tax_line    =  pod_line.

               if substring(abs_mstr.abs__qad06,1,1) = "Y" then
                  tax_taxable = true.
               if substring(abs_mstr.abs__qad06,2,1) = "Y" then
                  tax_in      = true.

               assign
                  tax_taxc    =
                     right-trim(substring(abs_mstr.abs__qad06,3,3))
                  tax_env     =
                     right-trim(substring(abs_mstr.abs__qad06,6,16))
                  tax_usage   =
                     right-trim(substring(abs_mstr.abs__qad06,22,8)) .

               if substring(work_abs_mstr.abs__qad07,9,18) <> ""
               then
                  tax_price =
                     decimal(substring(work_abs_mstr.abs__qad07,9,18))
                     / decimal(work_abs_mstr.abs__qad03) * pod_um_conv.

            end.

         end.

         if last-of(pod_nbr) then do:

            po_recno = recid(po_mstr).

            {mfnctrlc.i poc_ctrl poc_rcv_pre poc_rcv_nbr prh_hist
                         prh_receiver receivernbr}

            for first poc_ctrl
            fields (poc_rcv_nbr poc_rcv_pre poc_tol_cst poc_tol_pct)
            no-lock: end. /* FOR FIRST POC_CTRL */

            if (oldcurr <> po_curr) or (oldcurr = "") then do:
               /* GET ROUNDING METHOD FROM CURRENCY MASTER */
               {gprunp.i "mcpl" "p" "mc-get-rnd-mthd"
                  "(input po_curr,
                    output rndmthd,
                    output mc-error-number)"}
               if mc-error-number <> 0 then do:
                  {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=3}
                  if c-application-mode <> "WEB" then
                     pause 0.
                  undo-loop = yes.
                  return.
               end.
               oldcurr = po_curr.
            end.

            if po_fix_rate = no then do:
               /* GET EXCHANGE RATE */
               {gprunp.i "mcpl" "p" "mc-get-ex-rate"
                  "(input po_curr,
                    input base_curr,
                    input exch_ratetype,
                    input eff_date,
                    output exch_rate,
                    output exch_rate2,
                    output mc-error-number)"}
               if mc-error-number <> 0 then do:
                  {pxmsg.i &MSGNUM=mc-error-number &ERRORLEVEL=3}
                  undo-loop = yes.
                 return.
               end.
            end.
            else
               assign
                  exch_rate = po_ex_rate
                  exch_rate2 = po_ex_rate2.

            /* IF FISCAL RECEIVING THEN COPY THE TAX DETAIL RECORDS */
            /* OF TRANS TYPE 24 TO TRANS_TYPE 21                    */
            if work_abs_mstr.abs__qad06 <> "" then do:
               fiscal_rec = true .
               {gprun.i  ""txdetcpy.p""
                  "(input fiscal_id,
                    input pod_nbr,
                    input ""24"",
                    input receivernbr,
                    input pod_nbr,
                    input ""21"")" }
/*GUI*/ if global-beam-me-up then undo, leave.

            end.

            assign
               porec = yes
               is-return = no
               tax_tr_type = '21'
               transtype   = "RCT-PO"
               cmmt-prefix = "RCPT:".


            /* CALCULATE QTY OPEN FOR DISCRETE PO'S BEING RECEIVED
             * THROUGH THE SCHEDULED ORDER RECEIPT FUNCTION. QTY
             * OPEN IS NEEDED FOR SUPPLIER PERFORMANCE CALCULATIONS */
            if not pod_sched then do:
               {gprun.i ""rsoqty.p""
                  "(input recid(pod_det),
                    input receipt_date,
                    output qopen)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            end. /* if not pod_sched then do: */

            /* RELEASE POD_DET ENSURES THAT IN ORACLE ENVIRONMENT */
            release pod_det.

            {gprun.i ""poporcb.p""
               "(input shipnbr, input ship_date,
                 input inv_mov, input abs_mstr.abs_shipto, input auto_receipt,
                 input no, input 0, input """", output op_rctpo_trnbr)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            {gprun.i ""poporcd.p""}
/*GUI*/ if global-beam-me-up then undo, leave.



         end.
/*GUI*/ if global-beam-me-up then undo, leave.
  /* last-of (pod_nbr) */

      end.    /* for each work_abs_mstr */

      run upd-kit-inv
        (output undo_receipt).

      if undo_receipt then
         undo-loop = yes.

      /* ADDED THE FOLLOWING CODE FOR DETAILED ALLOCATION OF BTB SO */
      /* AND SHIPMENT OF THE BTB DIRECT DELIVERY SO LINES           */
      for first abs_mstr
      fields (abs_cum_qty abs_id abs_line abs_loc abs_lotser
              abs_order abs_qty abs_ref abs_shipfrom abs_shipto
              abs_ship_qty abs_shp_date abs_site abs_status
              abs_type abs__qad06)
      where recid(abs_mstr) = abs_recid
      no-lock: end. /* FOR FIRST ABS_MSTR */

      /* DETAILED ALLOCTION FOR EMT SO */
      {gprun.i ""rssoall.p""
         "(input abs_mstr.abs_id, input abs_mstr.abs_shipfrom)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      /* SO SHIPMENT FOR DIRECT DELIVERY EMT SO */
      {gprun.i ""rcshld.p""
         "(input abs_mstr.abs_id, input abs_mstr.abs_shipfrom,
           output undo_tran)"}
/*GUI*/ if global-beam-me-up then undo, leave.

      if undo_tran then do:
         undo-loop = yes.
         return.
      end.

      /* UPDATE THE SHIP QTY OF THE abs_mstr RECORD NOW.*/
      for each work_abs_mstr no-lock
      where work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty,
      each abs_mstr exclusive-lock
      where abs_mstr.abs_shipfrom = work_abs_mstr.abs_shipfrom
      and abs_mstr.abs_id = work_abs_mstr.abs_id:
         assign
            abs_mstr.abs_ship_qty = abs_mstr.abs_qty.
      end.

      /* END SECTION ADDED */

   end. /* TRANSACTION  CREATE RCT-PO & ISS-SO */


END PROCEDURE.
